home *** CD-ROM | disk | FTP | other *** search
/ Aminet 52 / Aminet 52 (2002)(GTI - Schatztruhe)[!][Dec 2002].iso / Aminet / dev / gg / ncurses-5.3.lha / ncurses-5.3 / Ada95 / src / terminal_interface-curses-aux.a < prev    next >
Text File  |  2002-10-24  |  5KB  |  118 lines
  1. ------------------------------------------------------------------------------
  2. --                                                                          --
  3. --                           GNAT ncurses Binding                           --
  4. --                                                                          --
  5. --                      Terminal_Interface.Curses.Aux                       --
  6. --                                                                          --
  7. --                                 B O D Y                                  --
  8. --                                                                          --
  9. ------------------------------------------------------------------------------
  10. -- Copyright (c) 1998 Free Software Foundation, Inc.                        --
  11. --                                                                          --
  12. -- Permission is hereby granted, free of charge, to any person obtaining a  --
  13. -- copy of this software and associated documentation files (the            --
  14. -- "Software"), to deal in the Software without restriction, including      --
  15. -- without limitation the rights to use, copy, modify, merge, publish,      --
  16. -- distribute, distribute with modifications, sublicense, and/or sell       --
  17. -- copies of the Software, and to permit persons to whom the Software is    --
  18. -- furnished to do so, subject to the following conditions:                 --
  19. --                                                                          --
  20. -- The above copyright notice and this permission notice shall be included  --
  21. -- in all copies or substantial portions of the Software.                   --
  22. --                                                                          --
  23. -- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS  --
  24. -- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF               --
  25. -- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.   --
  26. -- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM,   --
  27. -- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR    --
  28. -- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR    --
  29. -- THE USE OR OTHER DEALINGS IN THE SOFTWARE.                               --
  30. --                                                                          --
  31. -- Except as contained in this notice, the name(s) of the above copyright   --
  32. -- holders shall not be used in advertising or otherwise to promote the     --
  33. -- sale, use or other dealings in this Software without prior written       --
  34. -- authorization.                                                           --
  35. ------------------------------------------------------------------------------
  36. --  Author:  Juergen Pfeifer, 1996
  37. --  Contact: http://www.familiepfeifer.de/Contact.aspx?Lang=en
  38. --  Version Control:
  39. --  $Revision: 1.9 $
  40. --  Binding Version 01.00
  41. ------------------------------------------------------------------------------
  42. package body Terminal_Interface.Curses.Aux is
  43.    --
  44.    --  Some helpers
  45.    procedure Fill_String (Cp  : in  chars_ptr;
  46.                           Str : out String)
  47.    is
  48.       --  Fill the string with the characters referenced by the
  49.       --  chars_ptr.
  50.       --
  51.       Len : Natural;
  52.    begin
  53.       if Cp /= Null_Ptr then
  54.          Len := Natural (Strlen (Cp));
  55.          if Str'Length < Len then
  56.             raise Constraint_Error;
  57.          end if;
  58.          declare
  59.             S : String (1 .. Len);
  60.          begin
  61.             S := Value (Cp);
  62.             Str (Str'First .. (Str'First + Len - 1)) := S (S'Range);
  63.          end;
  64.       else
  65.          Len := 0;
  66.       end if;
  67.  
  68.       if Len < Str'Length then
  69.          Str ((Str'First + Len) .. Str'Last) := (others => ' ');
  70.       end if;
  71.  
  72.    end Fill_String;
  73.  
  74.    function Fill_String (Cp : chars_ptr) return String
  75.    is
  76.       Len : Natural;
  77.    begin
  78.       if Cp /= Null_Ptr then
  79.          Len := Natural (Strlen (Cp));
  80.          if Len = 0 then
  81.             return "";
  82.          else
  83.             declare
  84.                S : String (1 .. Len);
  85.             begin
  86.                Fill_String (Cp, S);
  87.                return S;
  88.             end;
  89.          end if;
  90.       else
  91.          return "";
  92.       end if;
  93.    end Fill_String;
  94.  
  95.    procedure Eti_Exception (Code : Eti_Error)
  96.    is
  97.    begin
  98.       case Code is
  99.          when E_Ok              => null;
  100.          when E_System_Error    => raise Eti_System_Error;
  101.          when E_Bad_Argument    => raise Eti_Bad_Argument;
  102.          when E_Posted          => raise Eti_Posted;
  103.          when E_Connected       => raise Eti_Connected;
  104.          when E_Bad_State       => raise Eti_Bad_State;
  105.          when E_No_Room         => raise Eti_No_Room;
  106.          when E_Not_Posted      => raise Eti_Not_Posted;
  107.          when E_Unknown_Command => raise Eti_Unknown_Command;
  108.          when E_No_Match        => raise Eti_No_Match;
  109.          when E_Not_Selectable  => raise Eti_Not_Selectable;
  110.          when E_Not_Connected   => raise Eti_Not_Connected;
  111.          when E_Request_Denied  => raise Eti_Request_Denied;
  112.          when E_Invalid_Field   => raise Eti_Invalid_Field;
  113.          when E_Current         => raise Eti_Current;
  114.       end case;
  115.    end Eti_Exception;
  116.  
  117. end Terminal_Interface.Curses.Aux;
  118.